home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 7
/
FM Towns Free Software Collection 7.iso
/
data
/
happysrc
/
pcetc.c
< prev
next >
Wrap
Text File
|
1993-11-30
|
15KB
|
369 lines
/**********************************************************************
*
* *** HAPPy Pascal compiler ***
* 各種サブルーチン群
*
* void skip(Set fsys)
* void updatelc(int upsize)
* void getbounds(stp *fsp,long *fmin, long *fmax)
* boolean equalbounds(stp *fsp1, stp *fsp2)
* int align(stp *fsp,int flc)
* void constant(Set fsys, stp **fsp, union valu *fvalu)
* boolean compatible(stp *fsp1,stp *fsp2)
* boolean assigncompati(stp *fsp1,stp *fsp2)
* boolean string(stp *fsp) ;
*
* Copyright (c) H.Asano 1992
*
**********************************************************************/
#define EXTERN extern
#include <string.h>
#include "pascomp.h"
typedef enum _sign {none, pos, neg } signflag ;
boolean string(stp*) ;
static int alignquot(stp*) ;
static void conststrings(stp**, union valu*) ;
static void constident(signflag,stp**, union valu*) ;
extern void pcerr(int,char*) ;
extern void insymbol(void) ;
extern ctp *searchid(Set) ;
extern Set *mkset(Set*,int,...) ;
extern Set *orset(Set*,Set*) ;
extern void term(void) ;
extern void *Malloc(int) ;
extern void applied(ctp*,int) ;
/**************************************/
/* skip() : 誤り回復のためにsymbolを */
/* キーにして読み飛ばす */
/**************************************/
void skip(Set fsys)
{
while(! inset(fsys,sy))
insymbol() ;
}
/**************************************/
/* updatelc() : location counter更新 */
/**************************************/
void updatelc(int upsize)
{
if(Maxaddr-upsize < lc)
pcerr(609,"") ; /* 変数割当できない */
else lc += upsize ; /* lc を更新 */
}
/*******************************************************/
/* getbounds() : 範囲型,文字型,整数型、集合型,列挙型の */
/* 下限、上限値を求める */
/* (* assume fsp<>intptr and fsp<>realptr *) */
/*******************************************************/
void getbounds(stp *fsp,long *fmin, long *fmax)
{
if(!fsp) return ;
if(fsp == charptr) { /* 文字型 */
*fmin = ordminchar ; /* 一番小さい文字コード */
*fmax = ordmaxchar ; /* 一番大きい文字コード */
}
else if(fsp == intptr) { /* 整数型 */
*fmin = -Maxint ; /* -Maxint .. Maxint */
*fmax = Maxint ;
}
else if(fsp->form == subrange) { /* 範囲型 */
*fmin = fsp->sf.su.min ; /* 下限 */
*fmax = fsp->sf.su.max ; /* 上限 */
}
else if(fsp->form == power) { /* 集合型 */
*fmin = fsp->sf.pw.elmin ; /* 下限 */
*fmax = fsp->sf.pw.elmax ; /* 上限 */
}
else if(fsp->sf.sc.fconst) { /* 列挙型の時 */
*fmax = fsp->sf.sc.fconst->n.values.ival ; /* 最後の列挙名の値 */
*fmin = 0 ;
}
}
/****************************************/
/* equalbounds() : 2つの型の上限、下限が */
/* 等しいか判定する */
/****************************************/
boolean equalbounds(stp *fsp1, stp *fsp2)
{
long lmin1,lmin2,lmax1,lmax2 ;
if((!fsp1) || (!fsp2)) return(true) ; /* 今のところ意味不明 */
getbounds(fsp1,&lmin1,&lmax1) ; /* fsp1 の下限、上限を調べる */
getbounds(fsp2,&lmin2,&lmax2) ; /* fsp2 の下限、上限を調べる */
return((lmin1==lmin2) && (lmax1==lmax2)) ;/* 両方とも等しいとき真*/
}
/************************************************/
/* align() : 型に応じた割りつけ開始番地を求める */
/* flc : 今の番地 */
/* return : 割りつけ開始番地 */
/************************************************/
int align(stp *fsp,int flc)
{
int k, l;
k = alignquot(fsp) ; /* その型の境界値を求める */
l = flc - 1 + k ; /* flc以上の最小のkの公倍数を */
return(l - l%k) ; /* 返却する */
}
/**************************************/
/* alignquot() : 型の境界を求める */
/* align の 内部関数 */
/**************************************/
static int alignquot(stp *fsp)
{
if(!fsp) return(1) ; /* 型ポインタがない時は1 */
switch(fsp->form) {
case scalar : /* スカラー型 */
if(fsp==intptr) return(intal) ; /* integer型 */
if(fsp==boolptr) return(boolal) ; /* boolean型 */
if(fsp==charptr) return(charal) ; /* char 型 */
if(fsp==realptr) return(realal) ; /* real 型 */
if(fsp->sf.sc.scalkind == declared) /* 列挙 型 */
return(intal) ;
return(parmal) ; /* parameter list*/
case subrange : /* 範囲型 */
return(alignquot(fsp->sf.su.rangetype)) ; /* 範囲の元の型 */
case pointer : /* ポインタ型 */
return(adral) ;
case power : /* 集合型 */
return(setal) ;
case files : /* ファイル型 */
return(fileal) ;
case arrays : /* 配列型 */
return(alignquot(fsp->sf.ar.aeltype)) ;
/* 要素の型 */
case records : /* レコード */
return(recal) ;
/* case variant : */ /* 可変レコード */
/* case tagfld : */ /* 可変レコードのタグ名 */
/* このルートはない */
}
}
/*********************************************/
/* constant() : 定数の処理 */
/*********************************************/
void constant(Set fsys, stp **fsp, union valu *fvalu)
{
stp *lsp ;
signflag sign ;
Set ws ;
lsp = nil ;
(*fvalu).ival = 0 ;
if(! inset(constbegsys,sy)) { /* 定数として許されない時 */
pcerr(50,"") ; /* 定数に誤りがある */
ws = fsys ;
orset(&ws,&constbegsys) ;
skip(ws) ; /* fsys+constbegsysまでskip*/
}
if(inset(constbegsys,sy)) { /* 定数としてOKの時 */
if(sy == stringconst) /* 文字列定数の時 */
conststrings(fsp,fvalu) ; /* 文字列定数の処理 */
else {
/*** 文字列以外の時は まず符号(+ -)の処理をする ***/
sign = none ;
if((op == plus) || (op == minus)) { /* + - の 時 */
sign = (op == plus) ? pos : neg ; /* 符号の選別 */
insymbol() ;
}
if(sy == ident) /* 名前の時 */
constident(sign,fsp,fvalu) ; /* 名前定数の処理 */
else if(sy == intconst) { /* 整数定数の時 */
if(sign == neg) val.ival = -val.ival ; /* -の時は値を反転 */
*fsp = intptr ;
*fvalu = val ;
insymbol() ;
}
else if(sy == realconst) { /* 実数定数の時 */
if(sign == neg)
*(val.valp->c.rval) = '-' ; /* 頭に負の符号をつける */
*fsp = realptr ;
*fvalu = val ;
insymbol() ;
}
else { /* それ以外 */
pcerr(106,"") ; /* 数がない */
skip(fsys) ;
}
}
}
if(! inset(fsys,sy)) {
pcerr(6,"") ; /* 不当な記号が現れた */
skip(fsys) ;
}
}
/***************************************/
/* conststrings(): 文字列定数の処理 */
/***************************************/
static void conststrings(stp **fsp, union valu *fvalu)
{
stp *lsp,*lsp1 ;
if(lgth == 1) lsp = charptr ; /* 1文字は文字型 */
else if(lgth == 0) lsp = nil ; /* 0文字はエラー */
else {
lsp = (stp*)Malloc(sizeof(stp));
lsp->size = lgth*charsize ; /* 文字列長 */
lsp->form = arrays ; /* 配列型 */
lsp->sf.ar.packed = true ; /* 詰め込み型である */
lsp->sf.ar.aeltype = charptr ; /* 要素の型は文字型 */
lsp1 = (stp*)Malloc(sizeof(stp)) ;/* 添字の型は */
lsp1->form = subrange ; /* 範囲型 */
lsp1->size = intsize ;
lsp1->sf.su.rangetype = intptr ;
lsp1->sf.su.min = 1 ; /* 添字の下限値は1 */
lsp1->sf.su.max = (long)lgth ; /* 添字の上限値は文字列長 */
lsp->sf.ar.inxtype = lsp1 ; /* 添字の型をこの範囲型とする*/
}
*fvalu = val ; /* 文字列を返却 */
*fsp = lsp ;
insymbol() ;
}
/***************************************/
/* constident(): 名前定数の処理 */
/***************************************/
static void constident(signflag fsign,stp **fsp, union valu *fvalu)
{
stp *lsp ;
ctp *lcp ;
csp *lvp ;
int i ;
Set ws ;
mkset(&ws, konst, -1) ;
lcp = searchid(ws) ; /* 定数の名前から探す */
applied(lcp,level) ; /* 参照名チェーン */
lsp = lcp->idtype ;
*fvalu = lcp->n.values ; /* 名前の値 */
if(fsign != none) { /* 符号がある時 */
if(lsp == intptr) { /* 整数 */
if(fsign == neg)
(*fvalu).ival = -(*fvalu).ival; /* 値を反転 */
}
else if(lsp == realptr) { /* 実数 */
if(fsign == neg) {
lvp = (csp*)Malloc(sizeof(csp));
lvp->cclass = real ;
lvp->c.rval = (char*)Malloc(Maxdiglng+1+1);
*(lvp->c.rval) = ((*(*fvalu).valp->c.rval)=='-')/* - * - = + */
? (char)' ' : (char)'-' ; /* + * - = - */
strcpy(lvp->c.rval+1,
(*fvalu).valp->c.rval+1); /* 中身を移しかえ */
(*fvalu).valp = lvp ;
}
}
else pcerr(105,lcp->name) ; /* 整数や実数でないのに */
/* 符号があるので、符号は駄目*/
/* のエラーメッセージ */
}
*fsp = lsp ;
insymbol() ;
}
/********************************************/
/* compatible() : 2つの型が適合するか判定 */
/********************************************/
boolean compatible(stp *fsp1,stp *fsp2)
{
if(fsp1 == fsp2) return(true) ; /* 型のアドレスが同じなら等しい*/
if((!fsp1) || (!fsp2)) return(true);
/* どちらかがnilならば、すでに
エラーメッセージが出ている
はずなので、ここでさらに
エラーを検出させないためtrue*/
if(fsp1->form == fsp2->form) /* 型が等しい */
switch(fsp1->form) {
case subrange : return /* 部分範囲型 */
(fsp1->sf.su.rangetype == fsp2->sf.su.rangetype);
/* 両方が 同じ型 */
case power : /* 集合型 */
if((fsp1->sf.pw.packed == both) ||
(fsp2->sf.pw.packed == both))
return(compatible(fsp1->sf.pw.elset, /*基底の型*/
fsp2->sf.pw.elset )) ;/*のD適合*/
else return
(!(fsp1->sf.pw.packed ^ fsp2->sf.pw.packed) &&
/* 両方とも詰めなしか詰めあり */
compatible(fsp1->sf.pw.elset, /* 基底の型が*/
fsp2->sf.pw.elset )) ; /* 適合 */
case pointer : return /* ポインタ型 */
((fsp1 == nilptr) || (fsp2 == nilptr)) ;
/* nilは全てのポインタ型と適合 */
case arrays : return /* 配列型 */
(string(fsp1) && string(fsp2) &&
(fsp1->sf.ar.inxtype->sf.su.max ==
fsp2->sf.ar.inxtype->sf.su.max));
/* 同数の成分を持つ文字列型の
時は適合する */
default : return(false) ; /* それ以外の型は不適合 */
}
else if(fsp1->form == subrange) /* fsp1がfsp2の部分範囲か */
return (fsp1->sf.su.rangetype == fsp2) ;
else if(fsp2->form == subrange) /* fsp2がfsp1の部分範囲か */
return (fsp1 == fsp2->sf.su.rangetype) ;
else return(false) ;
}
/***************************************************/
/* assigncompati() : 2つの型の代入可能性を判定する */
/* 型fsp1に対して型fsp2が代入可能の時真 */
/***************************************************/
boolean assigncompati(stp *fsp1,stp *fsp2)
{
if(fsp1 == fsp2) /* 同じ型 */
return(fsp1->assignflag) ; /* 代入可能性のチェック */
else if((fsp1 == realptr) && compatible(fsp2,intptr)) return(true) ;
else return(compatible(fsp1,fsp2)) ;
}
/**************************************/
/* string() : 型が文字列か判定する */
/**************************************/
boolean string(stp *fsp)
{
if(!fsp) return(false) ;
if((fsp->form == arrays) /* 配列型 */
&& (fsp->sf.ar.packed) /* packed指定あり */
&& (compatible(fsp->sf.ar.aeltype,charptr)) /* 要素の型が文字型*/
&& (fsp->sf.ar.inxtype->form == subrange) /* 添字の型は範囲 */
&& (fsp->sf.ar.inxtype->sf.su.min == 1) /* 下限値は1 */
&& (fsp->sf.ar.inxtype->sf.su.max > 1 )) /* 上限値は2以上 */
return(true) ; /* その時 文字列と認められる */
else return(false) ; /* 上記以外は文字列ではない */
}